home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbc_bas.exe / BOXMENU1.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-01-11  |  11.8 KB  |  319 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
  8.    DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
  9.    DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
  10.    DECLARE SUB Delay18th (BYVAL WaitTime%)
  11.    DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  12.    DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  13.    DECLARE FUNCTION GetCRT2% ()
  14.    DECLARE FUNCTION GetEGA2% ()
  15.    DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  16.    DECLARE SUB GetMouseLoc (Row%, Column%)
  17.    DECLARE FUNCTION GetVGA2% ()
  18.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  19.    DECLARE SUB MMButton3 (LeftB%, MidB%, RightB%)
  20.    DECLARE SUB MMCursorOff ()
  21.    DECLARE SUB MMCursorOn ()
  22.    DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
  23.    DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
  24.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)
  25.  
  26. SUB BoxMenu1 (Mouse%, PickList$(), Picked%(), Marker$, TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, ItemListAttr%, HiliteAttr%, TitleFore%, Title$, Grow%, Shade%, Picks%)
  27.  
  28.    CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
  29.    IF Visible% THEN LOCATE , , 0
  30.  
  31.    IF LEN(Marker$) > 1 THEN
  32.       LMarker$ = LEFT$(Marker$, 1)
  33.       RMarker$ = MID$(Marker$, 2, 1)
  34.    ELSE
  35.       LMarker$ = "<"
  36.       RMarker$ = ">"
  37.    END IF
  38.  
  39.    LastItem% = 0
  40.    Columns% = 0
  41.    Picks% = 0
  42.    t1% = UBOUND(PickList$, 1)
  43.    FOR tmp% = t1% TO 1 STEP -1
  44.       t2% = LEN(PickList$(tmp%))
  45.       IF t2% THEN
  46.          IF LastItem% = 0 THEN LastItem% = tmp%
  47.          IF Columns% < t2% THEN Columns% = t2%
  48.          IF Picked%(tmp%) THEN Picks% = Picks% + 1
  49.       END IF
  50.    NEXT
  51.    IF LastItem% THEN
  52.       Columns% = Columns% + 2
  53.       IF Columns% > 75 THEN Columns% = 75
  54.       FOR tmp% = 1 TO LastItem%
  55.          IF LEN(PickList$(tmp%)) = 0 THEN Picked%(tmp%) = 0
  56.       NEXT
  57.    ELSE
  58.       Columns% = 14
  59.    END IF
  60.  
  61.    GetVidMode VMode%, Cols%, Page%          ' use active display page
  62.  
  63.    IF GetCRT2% THEN                         ' use fast display unless CGA
  64.       IF GetEGA2% OR GetVGA2% THEN
  65.          Fast% = -1
  66.       ELSE
  67.          Fast% = 0
  68.       END IF
  69.    ELSE
  70.       Fast% = -1
  71.    END IF
  72.  
  73.    RightCol% = LeftCol% + Columns% - 1      ' set right column
  74.    Rows% = BottomRow% - TopRow% + 1         ' and number of rows
  75.  
  76.    IF Shade% THEN
  77.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
  78.    ELSE
  79.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
  80.    END IF
  81.    DIM SavedScreen%(Words%)
  82.  
  83.    TopRec% = 1
  84.    HiliteRow% = 1
  85.  
  86.    '--- save the screen
  87.    IF Mouse% THEN MMCursorOff
  88.    DSeg% = VARSEG(SavedScreen%(1))
  89.    DOfs% = VARPTR(SavedScreen%(1))
  90.    IF Shade% THEN
  91.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  92.    ELSE
  93.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  94.    END IF
  95.  
  96.    UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
  97.    WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleFore%, Title$, Page%, Fast%
  98.    IF Mouse% THEN MMCursorOn
  99.    GOSUB DisplayItems
  100.  
  101.    DO
  102.       '--- get input from appropriate device(s)
  103.       IF LeftButton% THEN Delay18th 2
  104.       DO
  105.          IF Mouse% THEN MMButton3 LeftButton%, MidButton%, RightButton%
  106.          IF LeftButton% = 0 AND MidButton% = 0 AND RightButton% = 0 THEN
  107.             BIOSInkey AsciiCode%, ScanCode%
  108.          END IF
  109.       LOOP UNTIL LeftButton% OR MidButton% OR RightButton% OR AsciiCode% OR ScanCode%
  110.       '--- handle mouse input, if any
  111.       IF Mouse% THEN
  112.          IF RightButton% THEN
  113.             AsciiCode% = 27
  114.          ELSEIF (LastItem% < 1) AND (LeftButton% OR MidButton%) THEN
  115.             AsciiCode% = 27
  116.          ELSEIF MidButton% THEN
  117.             AsciiCode% = 13
  118.          ELSEIF LeftButton% THEN
  119.             GetMouseLoc MouseRow%, MouseCol%
  120.             IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
  121.                IF MouseCol% = RightCol% + 1 THEN
  122.                   tmp% = SCREEN(MouseRow%, MouseCol%)
  123.                   IF tmp% = 24 THEN
  124.                      ' convert to ^E (same as up arrow)
  125.                      AsciiCode% = 5
  126.                   ELSEIF tmp% = 25 THEN
  127.                      ' convert to ^X (same as down arrow)
  128.                      AsciiCode% = 24
  129.                   END IF
  130.                ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
  131.                   IF MouseRow% - TopRow% + TopRec% <= LastItem% THEN
  132.                      HiLiteRow% = MouseRow% - TopRow% + 1
  133.                      AsciiCode% = 32
  134.                   END IF
  135.                END IF
  136.             END IF
  137.          END IF
  138.       END IF
  139.       '--- handle keyboard input, if any
  140.       IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
  141.          IF AsciiCode% = 17 THEN          ' ^Q WordStar key combo processing
  142.             GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
  143.             SELECT CASE AsciiCode%
  144.                CASE 3                     ' ^QC converts to ^<PgDn>
  145.                   AsciiCode% = 0
  146.                   ScanCode% = 118
  147.                CASE 18                    ' ^QR converts to ^<PgUp>
  148.                   AsciiCode% = 0
  149.                   ScanCode% = 132
  150.                CASE ELSE
  151.                   AsciiCode% = 0
  152.                   ScanCode% = 0
  153.             END SELECT
  154.          END IF
  155.          IF AsciiCode% = 0 AND ScanCode% = 71 THEN
  156.             ' <HOME>
  157.             IF HiliteRow% > 1 THEN
  158.                HiliteRow% = 1
  159.                GOSUB DisplayItems
  160.             END IF
  161.          ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
  162.             ' <END>
  163.             IF TopRec% + Rows% > LastItem% THEN
  164.                HiliteRow% = LastItem% - TopRec% + 1
  165.             ELSE
  166.                HiliteRow% = Rows%
  167.             END IF
  168.             GOSUB DisplayItems
  169.          ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
  170.             ' <CTRL><PGDN>
  171.             TopRec% = LastItem% - Rows% + 1
  172.             IF TopRec% < 1 THEN TopRec% = 1
  173.             IF TopRec% + Rows% > LastItem% THEN
  174.                HiliteRow% = LastItem% - TopRec% + 1
  175.             ELSE
  176.                HiliteRow% = Rows%
  177.             END IF
  178.             GOSUB DisplayItems
  179.          ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
  180.             ' <CTRL><PGUP>
  181.             IF TopRec% > 1 OR HiliteRow% > 1 THEN
  182.                TopRec% = 1
  183.                HiliteRow% = 1
  184.                GOSUB DisplayItems
  185.             END IF
  186.          ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
  187.             ' ^C or PgDn
  188.             IF TopRec% + 2 * Rows% - 1 < LastItem% THEN
  189.                TopRec% = TopRec% + Rows%
  190.             ELSE
  191.                TopRec% = LastItem% - Rows% + 1
  192.                IF TopRec% < 1 THEN TopRec% = 1
  193.             END IF
  194.             IF TopRec% > LastItem% THEN TopRec% = LastItem%
  195.             IF TopRec% + HiliteRow% - 1 >= LastItem% THEN
  196.                HiliteRow% = LastItem% - TopRec% + 1
  197.             END IF
  198.             GOSUB DisplayItems
  199.          ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
  200.             ' ^E or up arrow
  201.             IF HiliteRow% > 1 OR TopRec% > 1 THEN
  202.                IF HiliteRow% > 1 THEN
  203.                   HiliteRow% = HiliteRow% - 1
  204.                ELSE
  205.                   TopRec% = TopRec% - 1
  206.                END IF
  207.                GOSUB DisplayItems
  208.             END IF
  209.          ELSEIF AsciiCode% = 13 THEN
  210.             ' <CR>
  211.             IF LastItem% < 1 THEN
  212.                AsciiCode% = 27
  213.                LemmeOuttaHere% = -1
  214.             ELSE
  215.                DonePicking% = -1
  216.             END IF
  217.          ELSEIF AsciiCode% = 24 OR AsciiCode% = 0 AND ScanCode% = 80 THEN
  218.             ' ^X or down arrow
  219.             IF HiliteRow% < Rows% AND TopRec% + HiliteRow% - 1 < LastItem% THEN
  220.                HiliteRow% = HiliteRow% + 1
  221.                GOSUB DisplayItems
  222.             ELSE
  223.                IF TopRec% + Rows% - 1 < LastItem% THEN
  224.                   TopRec% = TopRec% + 1
  225.                   GOSUB DisplayItems
  226.                END IF
  227.             END IF
  228.          ELSEIF AsciiCode% = 18 OR AsciiCode% = 0 AND ScanCode% = 73 THEN
  229.             ' ^R or PgUp
  230.             IF TopRec% > Rows% THEN
  231.                TopRec% = TopRec% - Rows%
  232.                GOSUB DisplayItems
  233.             ELSE
  234.                IF TopRec% > 1 THEN
  235.                   TopRec% = 1
  236.                   GOSUB DisplayItems
  237.                END IF
  238.             END IF
  239.          ELSEIF AsciiCode% = 27 THEN
  240.             ' <ESC>
  241.             LemmeOuttaHere% = -1
  242.          ELSEIF AsciiCode% = 32 THEN
  243.             ' <space>
  244.             IF TopRec% + HiLiteRow% - 1 <= LastItem% THEN
  245.                tmp% = TopRec% + HiLiteRow% - 1
  246.                Picked%(tmp%) = NOT Picked%(tmp%)
  247.                IF Picked%(tmp%) THEN
  248.                   Picks% = Picks% + 1
  249.                ELSE
  250.                   Picks% = Picks% - 1
  251.                END IF
  252.                GOSUB DisplayItems
  253.             END IF
  254.          END IF
  255.       END IF
  256.    LOOP UNTIL DonePicking% OR LemmeOuttaHere%
  257.  
  258.    IF LemmeOuttaHere% AND Picks% THEN
  259.       FOR tmp% = 1 TO LastItem%
  260.          Picked%(tmp%) = 0
  261.       NEXT
  262.       Picks% = 0
  263.    END IF
  264.  
  265.    '--- restore the screen
  266.    IF Mouse% THEN MMCursorOff
  267.    DSeg% = VARSEG(SavedScreen%(1))
  268.    DOfs% = VARPTR(SavedScreen%(1))
  269.    IF Shade% THEN
  270.       DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  271.    ELSE
  272.       DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  273.    END IF
  274.    IF Mouse% THEN MMCursorOn
  275.    IF Visible% THEN LOCATE , , 1
  276.  
  277.    EXIT SUB
  278.  
  279. DisplayItems:
  280.    IF Mouse% THEN MMCursorOff
  281.    IF LastItem% < 1 THEN
  282.       XQPrint "...no items...", TopRow%, LeftCol%, HiliteAttr%, Page%, Fast%
  283.    ELSE
  284.       ' update scroll bar as needed
  285.       IF Rows% < LastItem% THEN
  286.          FOR Row% = TopRow% TO BottomRow%
  287.             XQPrint CHR$(178), Row%, RightCol% + 1, FrameAttr%, Page%, Fast%
  288.          NEXT
  289.          IF TopRec% > 1 AND Rows% > 1 THEN
  290.             XQPrint CHR$(24), TopRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  291.          END IF
  292.          IF TopRec% + Rows% - 1 < LastItem% AND Rows% > 0 THEN
  293.             XQPrint CHR$(25), BottomRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  294.          END IF
  295.       END IF
  296.       ' update item list
  297.       FOR Row% = 1 TO Rows%
  298.          tmp% = TopRec% + Row% - 1
  299.          IF tmp% <= LastItem% THEN
  300.             IF Picked%(tmp%) THEN
  301.                St$ = LMarker$ + LEFT$(LEFT$(PickList$(tmp%), Columns% - 2) + SPACE$(Columns%), Columns% - 2) + RMarker$
  302.             ELSE
  303.                St$ = LEFT$(" " + LEFT$(PickList$(tmp%), Columns% - 2) + SPACE$(Columns%), Columns%)
  304.             END IF
  305.          ELSE
  306.             St$ = SPACE$(Columns%)
  307.          END IF
  308.          IF Row% = HiliteRow% THEN
  309.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, HiliteAttr%, Page%, Fast%
  310.          ELSE
  311.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, ItemListAttr%, Page%, Fast%
  312.          END IF
  313.       NEXT
  314.    END IF
  315.    IF Mouse% THEN MMCursorOn
  316.    RETURN
  317.  
  318. END SUB
  319.